home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 008 / organ.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1984-04-24  |  6.2 KB  |  218 lines
  1. 10  DEFINT A-Z:ON ERROR GOTO 30
  2. 20  GOTO 50
  3. 30  'error handler
  4. 40  RESUME NEXT
  5. 50  OPTION BASE 1:DIM ROW(25)
  6. 60  FOR I=1 TO 25:READ ROW(I):NEXT I
  7. 70  DATA 6,25,20,2,15,24,1,13,7,9,5,18,3,14,19,4,8,11,23,12,22,10,16,17,21
  8. 80  WIDTH 40:KEY OFF:CLS:LOCATE ,,0
  9. 90  COLOR 7,0,1
  10. 100  FOR I = 1 TO 96
  11. 110   A = INT(RND*2400 + 1000)
  12. 120  PRINT STRING$(10,CHR$(14));
  13. 130  SOUND A,0.01
  14. 140  SOUND 100 + I,0.01
  15. 150  NEXT I
  16. 160  PLAY "l16o4go5cege2g"
  17. 170  COLOR 15,0:LOCATE 13,13:PRINT" VERSION XXXXX ";
  18. 180  COLOR 0,15:LOCATE 9,8:PRINT" The AMAZING,INCREDULOUS ";
  19. 190  COLOR 15,0:LOCATE 11,11:PRINT" RAVISONIC  ORGAN  ";
  20. 210  COLOR 15,3 :LOCATE 25,1:PRINT"       press any key to continue        ";
  21. 220  K$=INKEY$:IF K$ = "" THEN 220
  22. 230  COLOR 7,0,4
  23. 240  LOCATE 25,1:PRINT STRING$(79," "):LOCATE 25,1
  24. 250  FOR I = 1 TO 499
  25. 260  COLOR 15,0:PRINT STRING$(1,CHR$(17));:SOUND 19000,0.01:
  26. 270  COLOR 0,15:PRINT STRING$(1,CHR$(16));:SOUND 8200,0.01
  27. 280  NEXT I
  28. 290  COLOR 15,0:PRINT CHR$(17);
  29. 300  COLOR 15,0,0
  30. 310  PLAY "MNl4o1t255c2c8p8cd2"
  31. 320  LOCATE 4,3,0:PRINT "Conceived...";
  32. 330  PLAY "d8p8g2g8p8f8p8e8p8d8p8c2":LOCATE 4,21:PRINT "Composed...";
  33. 340  PLAY "c2c8p8cd2d8p8f2f8p8e-8p8d8p8c8p8o0b-2":LOCATE 6,11:PRINT "Contrived...";
  34. 350  PLAY "b-2b-b-o1c2d2ddd+2":LOCATE 7,25:PRINT "Devised...";
  35. 360  PLAY "d+o0b-2b-b-o1c2"
  36. 370  LOCATE 9,3:PRINT "and forged ";
  37. 380  PLAY "MBcg2gedcg2g2d+dcggccgg2ecgg2e-c1o0c1"
  38. 390  PRINT "from the cerebrations ";
  39. 400  LOCATE 11,2:PRINT "of the cosmic cognizant conciousnesses ";
  40. 410  LOCATE 13,20:PRINT "of..."
  41. 420  LOCATE 15,16:PRINT "RAVI THE GREAT";:COLOR 31,0
  42. 450  LOCATE 24,1:COLOR 15,0:PRINT "     press any key to continue         ";
  43. 460  FOR I=1 TO 2000:I=I:NEXT I
  44. 470  K$=INKEY$:IF K$="" THEN 470
  45. 480  FOR M=1 TO 20
  46. 490  FOR J=1 TO 25
  47. 500  LOCATE ROW(J),M+20:PRINT " ";
  48. 510  NEXT J
  49. 520  FOR L=1 TO 25
  50. 530  LOCATE ROW(L),21-M:PRINT " ";
  51. 540  NEXT L,M
  52. 550  CLS
  53. 560  CLS:SCREEN 1:IF FLAG<>0 THEN 590  ELSE FLAG=1
  54. 570  DIM BH1(500),BH2(500),TH1(500),TH2(500),RV1(500),RV2(500),LV1(500),LV2(500)
  55. 580  ON ERROR GOTO 30
  56. 590  COLOR 0,3
  57. 600  FOR A=14 TO 302 STEP 12
  58. 610  CIRCLE (A,4),4
  59. 620  NEXT A
  60. 630  FOR A=8 TO 196 STEP 9
  61. 640  CIRCLE (314,A),4
  62. 650  NEXT A
  63. 660  FOR A=314 TO 14 STEP -12
  64. 670  CIRCLE (A,196),4
  65. 680  NEXT A
  66. 690  FOR A=191 TO 8 STEP -9
  67. 700  CIRCLE (8,A),4
  68. 710  NEXT A
  69. 720  CIRCLE (14,4),4
  70. 730  COLOR 0,7
  71. 740  FOR A=26 TO 302 STEP 24
  72. 750  PAINT (A,4),2,3
  73. 760  NEXT A
  74. 770  GET (1,1)-(319,10),TH1
  75. 780  FOR A=26 TO 302 STEP 24
  76. 790  PAINT (A,4),0,3
  77. 800  NEXT A
  78. 810  FOR A=14 TO 302 STEP 24
  79. 820  PAINT (A,4),2,3
  80. 830  NEXT A:GET (1,1)-(319,10),TH2
  81. 840  FOR A=8 TO 196 STEP 18
  82. 850  PAINT (314,A),2,3
  83. 860  NEXT A
  84. 870  GET(310,1)-(319,199),RV1
  85. 880  FOR A=8 TO 196 STEP 18
  86. 890  PAINT (314,A),0,3
  87. 900  NEXT A
  88. 910  FOR A=17 TO 196 STEP 18
  89. 920  PAINT (314,A),2,3
  90. 930  NEXT A
  91. 940  GET(310,1)-(319,199),RV2
  92. 950  FOR A=314 TO 14 STEP -24
  93. 960  PAINT (A,196),2,3
  94. 970  NEXT A
  95. 980  GET (1,190)-(319,199),BH1
  96. 990  FOR A=314 TO 14 STEP -24
  97. 1000  PAINT (A,196),0,3
  98. 1010  NEXT A
  99. 1020  FOR A=302 TO 14 STEP -24
  100. 1030  PAINT (A,196),2,3
  101. 1040  NEXT A
  102. 1050  GET (1,190)-(319,199),BH2
  103. 1060  FOR A=183 TO 8 STEP -18
  104. 1070  PAINT (8,A),2,3
  105. 1080  NEXT A
  106. 1090  GET (1,1)-(12,199),LV1
  107. 1100  FOR A=183 TO 8 STEP -18
  108. 1110  PAINT (8,A),0,3
  109. 1120  NEXT A
  110. 1130  FOR A=191 TO 8 STEP -18
  111. 1140  PAINT (8,A),2,3
  112. 1150  NEXT A
  113. 1160  GET (1,1)-(12,199),LV2
  114. 1170  LOCATE 7,20:PRINT " MENU ";
  115. 1180  LOCATE 10,17:PRINT "a-ORGANITEK"
  116. 1190  LOCATE 12,17:PRINT "b-ORGANISCOPE"
  117. 1200  LOCATE 14,17:PRINT "c-BLUEZORG"
  118. 1210  LOCATE 16,17:PRINT "d-SPACEORG"
  119. 1220  LOCATE 18,17,0:PRINT "q-QUIT"
  120. 1230  LOCATE 20,5:PRINT "(First choose letter, then hit":LOCATE 21,7:PRINT "lowercase keys for tones)"
  121. 1240  PLAY "mbl4T190MSO4p1ge8p8ap8g8fd8p8gp8f8e8p8cf8p8dgp8g8c2"
  122. 1250  A$ = INKEY$:IF A$<> "" THEN 1350
  123. 1260  PUT (1,1),TH1,XOR:PUT(1,1),TH2
  124. 1270  PUT (310,1),RV1,XOR:PUT(310,1),RV2
  125. 1280  PUT (1,190),BH1,XOR:PUT(1,190),BH2
  126. 1290  PUT (1,1),LV1,XOR:PUT(1,1),LV2
  127. 1300  PUT(1,1),TH2,XOR:PUT(1,1),TH1
  128. 1310  PUT(310,1),RV2,XOR:PUT(310,1),RV1
  129. 1320  PUT(1,190),BH2,XOR:PUT(1,190),BH1
  130. 1330  PUT(1,1),LV2,XOR:PUT(1,1),LV1
  131. 1340  GOTO 1250
  132. 1350  IF A$ = "a" THEN 1420
  133. 1360  IF A$ = "b" THEN 1570
  134. 1370  IF A$ = "c" THEN 1780
  135. 1380  IF A$ = "d" THEN 1910
  136. 1390  IF A$ = "q" THEN 1410
  137. 1400  GOTO 1240
  138. 1410  GOTO 2070
  139. 1420  CLS:SCREEN 0:LOCATE ,,0
  140. 1430  COLOR 15,0,3:LOCATE 5,15:PRINT"ORGANITEK"
  141. 1440  LOCATE 11,3:PRINT"Demonstrates how each strike of the"
  142. 1450  LOCATE 13,3:PRINT "keyboard can set off a rapid"
  143. 1460  LOCATE 15,3:PRINT "succession of interrelated tones."
  144. 1470  LOCATE 19,10:PRINT"capital Q to return"
  145. 1480  A$=INKEY$: IF A$="" THEN 1480
  146. 1490  IF A$ = "Q" THEN 560
  147. 1500  B$="\XzXxcXvXbXnmX,X./XaXsXdfXgXhjXkXlX;'X`XqwXeXrXtyXuXioXpX[X]1X2X34X5X6X78X9X0-X="
  148. 1510  NO=INSTR(1,B$,A$):NM = NO + 5:NP = NO -5
  149. 1520  IF NM >80 THEN NM = 80
  150. 1530  IF NP < 0 THEN NP = 0
  151. 1540  NO$=STR$(NO):NP$ = STR$(NP):NM$ = STR$(NM)
  152. 1550  PLAY "l25t255n" + NO$+"n"+ NP$+"N"+NM$
  153. 1560  GOTO 1480
  154. 1570  CLS:SCREEN 0:LOCATE ,,0
  155. 1580  COLOR 15,0,3:LOCATE 5,15:PRINT"ORGANISCOPE"
  156. 1590  LOCATE 11,3:PRINT"Demonstrates how two successive strikes "
  157. 1600  LOCATE 13,3:PRINT "of the keyboard can be interelated."
  158. 1610  LOCATE 15,3:PRINT "(In this case hitting all the tones in- between.)
  159. 1620  LOCATE 19,10:PRINT"capital Q to return"
  160. 1630  NM=20
  161. 1640  A$=INKEY$: IF A$="" THEN 1640
  162. 1650  IF A$ = "Q" THEN 560
  163. 1660  'B$="\zxcvbnm,./asdfghjkl;'`qwertyuiop[]1234567890-="
  164. 1670  B$="\XzXxcXvXbXnmX,X./XaXsXdfXgXhjXkXlX;'X`XqwXeXrXtyXuXioXpX[X]1X2X34X5X6X78X9X0-X="
  165. 1680  NO=INSTR(1,B$,A$)
  166. 1690  NO$=STR$(NO):NM$ = STR$(NM)
  167. 1700  IF NM=NO THEN 1640
  168. 1710  PLAY "l64t255n" + NO$+"n"+NM$
  169. 1720   PLAY "mll18t255n" + NO$
  170. 1730  IF NM < NO THEN 1760
  171. 1740  IF NM > NO THEN 1770
  172. 1750  GOTO 1640
  173. 1760  NM = NM + 1:GOTO 1690
  174. 1770  NM = NM - 1:GOTO 1690
  175. 1780  CLS:SCREEN 0:LOCATE ,,0
  176. 1790  COLOR 15,0,3:LOCATE 5,15:PRINT"BLUEZORG"
  177. 1800  LOCATE 11,3:PRINT"Demonstrates how the scale can be"
  178. 1810  LOCATE 13,3:PRINT "changed from an ordinary `c'"
  179. 1820  LOCATE 15,3:PRINT "scale to a `c'BLUES scale."
  180. 1830  LOCATE 19,10:PRINT"capital Q to return"
  181. 1840  A$=INKEY$: IF A$="" THEN 1840
  182. 1850  IF A$ = "Q" THEN 560
  183. 1860  B$="\XXzxcvbXXnm,XX./asdXXfghXXjkl;'XX`qwXXertyuXXiopXX[]123XX123XX45678XX90-XX="
  184. 1870  NO=INSTR(1,B$,A$):NM = NO + 5:NP = NO -1:NO$=STR$(NO):NP$ = STR$(NP):NM$ = STR$(NM)
  185. 1880  'PLAY "l25t255n" + NO$+"n"+ NP$+"N"+NM$
  186. 1890   PLAY "mnl18t255n" + NO$
  187. 1900  GOTO 1840
  188. 1910  SCREEN 0:LOCATE ,,0:CLS
  189. 1920  COLOR 15,0,3:LOCATE 5,15:PRINT"SPACEORG"
  190. 1930  LOCATE 11,3:PRINT"Demonstrates how the sound and play"
  191. 1940  LOCATE 13,3:PRINT "commands can be intertwined"
  192. 1950  LOCATE 15,3:PRINT "resulting in,among other things,"
  193. 1960  LOCATE 17,3:PRINT"a drone tone."
  194. 1970  LOCATE 19,10:PRINT"capital Q to return"
  195. 1980  A$=INKEY$: IF A$="" THEN 1980
  196. 1990  IF A$ = "Q" THEN 560
  197. 2000   B$=" \XzXxcXvXbXnmX,X./XaXsXdfXgXhjXkXlX;'X`XqwXeXrXtyXuXioXpX[X]1X2X34X5X6X78X9X0-X="
  198. 2010  NO=INSTR(1,B$,A$):NM = NO + 1:NP = NO -1:NO$=STR$(NO):NP$ = STR$(NP):NM$ = STR$(NM)
  199. 2020   PLAY "l64t255n" + NO$+"n"+ NP$+"N"+NM$
  200. 2030   PLAY "mnl30t255n" + NO$
  201. 2040  SOUND 37,0.5:SOUND 40,0.5
  202. 2050  A$=INKEY$: IF A$ ="" THEN 2030
  203. 2060  IF A$= "Q"THEN 560 ELSE GOTO 2000
  204. 2070  SCREEN 0:CLS:COLOR 15,4,3:LOCATE,,0
  205. 2080  A$="O1DDDO0A8B8O1L4C+D8L8C+O0L4BA2.O1DC+O0BABG8L8F+L4ED2."
  206. 2090  CLS:COLOR 0:PLAY "mbxa$;":LOCATE 3,3:PRINT"Do your programs have more bugs than a    `Roach Motel'?"
  207. 2100  PLAY "xa$;":LOCATE 7,1:PRINT"Is your disk drive possessed??"
  208. 2110  B$="mbO0DF+ABG+A2.DAABO1C+D2.C+DC+O0BBA2.BBABGL2f+."
  209. 2120  PLAY "xb$;":LOCATE 9,3:PRINT "Does your microprocessor have the       predictability of a four year old with      hemorrhoids???"
  210. 2130  C$="L4O1DC+O0BABG8L8F+L4ED2."
  211. 2140  PLAY "xc$;":LOCATE 14,15:COLOR 31,4,3:PRINT"!REPENT!":COLOR 15,4,3
  212. 2150  LOCATE 16,3:PRINT "and send all pirated programs to..."
  213. 2160  LOCATE 18,3:PRINT "Church of the Divine Programmer"
  214. 2170  LOCATE 19,3:PRINT "Antichrist, VA  01666"
  215. 2180  LOCATE 23,1:PRINT TAB(10);"hit any key to exit"
  216. 2190  A$=INKEY$:IF A$="" THEN 2190
  217. 2200  COLOR 7,0,0:WIDTH 80:CLS
  218.